home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_bas / roseqb3.zip / ROSEQBAS.BAS < prev    next >
BASIC Source File  |  1996-01-30  |  26KB  |  554 lines
  1. '
  2. ' ROSEWOOD QUICKBASIC STUFF v 3 consists of two programs which can be
  3. ' incorporated into programs written in QuickBasic 4.xx or QBasic which
  4. ' is supplied with MS DOS 5 and 6. Libraries or commands such as
  5. ' CALL INTERRUPT not used in QBasic are not needed with this code.
  6. '
  7. ' There are two distinct parts of the program:
  8. '
  9. '   The first is an input editor which will replace the commands "INPUT",
  10. ' "LINE INPUT", etc. with an input routine written with INKEY$ as the input.
  11. ' INKEY$ allows much nicer inputting, especially if you have several inputs
  12. ' to process in succession. This editor can be set up to accept various types
  13. ' of input and to block other types. This will greatly reduce the amount of
  14. ' error checking which is associated with the usual input functions.
  15. '   Some parts of this program may look ancient with its IF..ENDs and GOTOs.
  16. ' However, I like to have the ability to cascade through the editor. See
  17. ' how scan% = 8 becomes scan% = 83 in the backspace command area. The program
  18. ' could be written using only DO..LOOP, SELECT CASE etc. but I doubt that it
  19. ' would make the program work better. It would be prettier though.
  20. ' The editor is very loosely based on a program from the magazine,
  21. ' PC RESOURCES, October 1987, pg. 61
  22. '
  23. '   The second part of the code is a simple window program. Windows of any
  24. ' size or colour, with or without a border, can be placed anywhere on the
  25. ' screen with text justified left, centre and right, and then wiped off so
  26. ' that the original screen below is restored. The speed in drawing and
  27. ' erasing these windows is not as great as windows using registers and
  28. ' CALL ABSOLUTE, but it is adequate for most purposes.
  29.  
  30. ' There are two window routines, WindowSub and WindowSub2. The first makes
  31. ' use of code pages using PCOPY and the second stores the window information
  32. ' in arrays. The first is faster and easier to use but may not be supported by
  33. ' all computers.
  34.  
  35. ' This code is written by:      Bert Christensen
  36. '                               Rosewood Software
  37. '                               135-10 Livonia Place
  38. '                               Scarborough, Ontario, Canada M1E 4W6
  39. '                               (416) 284-6119, CompuServe 70461,2507
  40. '                               Internet bert.christensen@canrem.com
  41. '
  42. '                               Copyright (c) 1996 by Bert Christensen
  43. '
  44. ' Anyone is granted full permission to use all or part of this program
  45. ' without charge. However, if you should feel moved to send a donation,
  46. ' it will not be refused.
  47. '
  48. ' Any comments would be appreciated.
  49. '
  50. '
  51. '           ROSEWOOD QUICKBASIC STUFF v 3
  52. '
  53. '           Programmed in MicroSoft QuickBasic 4.5 and VisualBasic for DOS 1.00
  54. '           October 1993 & November 1994. Revised January 1996
  55. '
  56. '
  57. '        ******DECLARATIONS*****
  58.  
  59. DECLARE SUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  60. DECLARE SUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  61. DECLARE SUB WindowSub2 (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  62. DECLARE FUNCTION Justify$ (text$, just%, winleft%, winright%)
  63. DECLARE SUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)
  64. COMMON SHARED /colours/ sfg%, sbg%, rfg%, rbg%, ffg%, fbg%
  65. sfg% = 0        'standard foreground
  66. sbg% = 7        'standard background
  67. rfg% = 7        'reverse foreground
  68. rbg% = 1        'reverse background
  69. REM ffg% = frame foreground
  70. REM fbg% = frame background
  71.  
  72.  
  73. REM ******************EDITOR SECTION**********************
  74.  
  75. LOCATE 1, 1     'goto top left so whole screen will be "coloured"
  76. COLOR sfg%, sbg%
  77. CLS
  78. COLOR rfg%, rbg%
  79. ' place prompts on the screen
  80. LOCATE 1, 12: PRINT "`Rosewood QB Stuff' Input Editor for QuickBasic & QBasic"
  81. COLOR sfg%, sbg%
  82. LOCATE 3, 5: PRINT "This field accepts 0 to 9 & space only"; : LOCATE 5, 5: PRINT "This field accepts all alphanumeric entries";
  83. LOCATE 7, 5: PRINT "This field accepts `0' to `9',`-', `.' and `space' only"; : LOCATE 9, 5: PRINT "The Esc key is disabled in this field";
  84. LOCATE 11, 5: PRINT "Edit pre-existing data"; : LOCATE 13, 5: PRINT "Field length of 1"; :   LOCATE 15, 5: PRINT "Field length of 45";
  85. LOCATE 17, 27: PRINT "Fields can be placed anywhere on screen"
  86. LOCATE 19, 1: PRINT STRING$(80, "*");
  87. LOCATE 20, 5: PRINT "Use arrow keys, Home, End, PgUp, PgDn, Del, Bksp, Ins to edit";
  88. LOCATE 21, 5: PRINT "Ctrl F3 to delete input; Ctrl F4 to copy text; Ctrl F5 to paste";
  89. LOCATE 22, 5: PRINT "Ctrl End & Ctrl Home to move to ends of field; Ctrl F10 to quit editing";
  90. LOCATE 23, 5: PRINT "Ctrl F6 to centre text";
  91. entryload$ = "Bert Christensen, Rosewood Software"      'see item$(5) below
  92. numentry% = 8   'number of input items. can be 1 to ??
  93.  
  94. REDIM item$(numentry%), itemlen%(numentry%), inperr%(numentry%), row%(numentry%), column%(numentry%), itemflag%(numentry%)
  95.  
  96. 'item$() = the input item. if there is data to be edited, see below at item$(5).
  97. 'if there is no data to be edited then item$() = " ".
  98. 'itemlen%() = the length of the item$().
  99. 'inperr%() is a flag to manipulate data in the sub, Fulledit
  100. 'column%() is the horizontal column position to start the editing of the particular item$()
  101. 'row%() is the vertical row to start editing the item$()
  102. 'itemflag%() is like inperr%() above (in case you should need 2)
  103. 'below is the filling of the arrray
  104.  
  105.         item$(1) = " ": itemlen%(1) = 5: inperr%(1) = 0: column%(1) = 44: row%(1) = 3: itemflag%(1) = 1
  106.         item$(2) = " ": itemlen%(2) = 25: inperr%(2) = 0: column%(2) = 50: row%(2) = 5: itemflag%(2) = 0
  107.         item$(3) = " ": itemlen%(3) = 10: inperr%(3) = 0: column%(3) = 64: row%(3) = 7: itemflag%(3) = 2
  108.         item$(4) = " ": itemlen%(4) = 6: inperr%(4) = 1: column%(4) = 45: row%(4) = 9: itemflag%(4) = 0      'inperr% = 1
  109.         item$(5) = entryload$: itemlen%(5) = 40: inperr%(5) = 0: column%(5) = 30: row%(5) = 11: itemflag%(5) = 0
  110.         item$(6) = " ": itemlen%(6) = 1: inperr%(6) = 0: column%(6) = 25: row%(6) = 13: itemflag%(6) = 0
  111.         item$(7) = " ": itemlen%(7) = 45: inperr%(7) = 0: column%(7) = 24: row%(7) = 15: itemflag%(7) = 0
  112.         item$(8) = " ": itemlen%(8) = 20: inperr%(8) = 0: column%(8) = 5: row%(8) = 17: itemflag%(8) = 0
  113.  
  114. CALL Fulledit(row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  115.  
  116.  
  117. REM ****************WINDOWS SECTION******************
  118.  
  119.     wintop% = 8             'initialize placement of window
  120.     winbot% = 21            '     "         "     "     "
  121.     winleft% = 10           '     "         "     "     "
  122.     winright% = 70          '     "         "     "     "
  123.  
  124.  
  125. DIM wintext$(winbot% - wintop% + 1)  'dimension array for lines of text
  126.  
  127.     REM wintext$(1) is a null string because the frame will cover it
  128.     wintext$(2) = Justify$("Results returned by Rosewood QB Stuff Input Editor", 2, winleft%, winright%)
  129.     wintext$(4) = "item$(1) = " + item$(1)
  130.     wintext$(5) = "item$(2) = " + item$(2)
  131.     wintext$(6) = "item$(3) = " + item$(3)
  132.     wintext$(7) = "item$(4) = " + item$(4)
  133.     wintext$(8) = Justify$("item$(5) = " + item$(5), 1, winleft%, winright%) 'see justify$ function
  134.     wintext$(9) = Justify$("item$(6) = " + item$(6), 0, winleft%, winright%)
  135.     wintext$(10) = "item$(7) = " + item$(7)
  136.     wintext$(11) = Justify$("item$(8) = " + item$(8), 0, winleft%, winright%)
  137.     wintext$(12) = ""
  138.     wintext$(13) = Justify$("Press any key to continue...", 2, winleft%, winright%)
  139.  
  140. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 4, wintext$(), 1)
  141.  
  142. REM ***********SECOND WINDOW**********
  143.  
  144. wintop% = 10
  145. winbot% = 22
  146. winleft% = 10
  147. winright% = 40
  148.  
  149. REDIM wintext$(winbot% - wintop% + 1)
  150.  
  151. FOR x% = 2 TO 6
  152.     wintext$(x%) = Justify$("Right Justified Text", 3, winleft%, winright%)
  153. NEXT x%
  154.  
  155. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 3, wintext$(), 0)
  156.  
  157. REM **********THIRD WINDOW**********
  158.  
  159. wintop% = 6
  160. winbot% = 11
  161. winleft% = 4
  162. winright% = 40
  163.  
  164. REDIM wintext$(winbot% - wintop% + 1)
  165. FOR x% = 2 TO 6
  166.     wintext$(x%) = Justify$("Centered Text", 2, winleft%, winright%)
  167. NEXT x%
  168. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 6, wintext$(), 1)
  169.  
  170. REM *********FOURTH WINDOW***********
  171.  
  172. wintop% = 13
  173. winbot% = 23
  174. winleft% = 10
  175. winright% = 70
  176.  
  177. REDIM wintext$(winbot% - wintop% + 1)
  178. wintext$(2) = Justify$("ROSEWOOD QUICKBASIC STUFF is brought to you by:", 2, winleft%, winright%)
  179. wintext$(3) = Justify$("Bert Christensen", 2, winleft%, winright%)
  180. wintext$(4) = Justify$("Rosewood Software", 2, winleft%, winright%)
  181. wintext$(5) = Justify$("135-10 Livonia Place", 2, winleft%, winright%)
  182. wintext$(6) = Justify$("Scarborough, Ontario M1E 4W6  Canada", 2, winleft%, winright%)
  183. wintext$(7) = Justify$("Telephone (416) 284-6119", 2, winleft%, winright%)
  184. wintext$(8) = Justify$("CompuServe 70461,2507  Internet bert.christensen@canrem.com", 2, winleft%, winright%)
  185. wintext$(10) = Justify$("Copyright (c) 1996", 2, winleft%, winright%)
  186. CALL WindowSub(wintop%, winbot%, winleft%, winright%, 15, 5, wintext$(), 1)
  187. COLOR sfg%, sbg%
  188.  
  189. END
  190.  
  191. SUB Frame (toprow%, bottomrow%, leftcol%, rightcol%)
  192.  
  193.         LOCATE toprow%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(201)  'top left corner
  194.         LOCATE toprow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(187) 'top right corner
  195.         LOCATE bottomrow%, leftcol%: COLOR ffg%, fbg%: COLOR ffg%, fbg%: PRINT CHR$(200); 'bottom left corner
  196.         LOCATE bottomrow%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(188); 'bottom right corner
  197.  
  198.         FOR vertline% = toprow% + 1 TO bottomrow% - 1       'vertical lines
  199.                 LOCATE vertline%, leftcol%: COLOR ffg%, fbg%: PRINT CHR$(186);
  200.                 LOCATE vertline%, rightcol%: COLOR ffg%, fbg%: PRINT CHR$(186);
  201.         NEXT vertline%
  202.  
  203.                 horizlength% = rightcol% - leftcol% - 1     'horizontal lines
  204.                 horizline$ = STRING$(horizlength%, 205)
  205.         LOCATE toprow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$
  206.         LOCATE bottomrow%, leftcol% + 1: COLOR ffg%, fbg%: PRINT horizline$;
  207.         LOCATE , , 0
  208. END SUB
  209.  
  210. SUB Fulledit (row%(), column%(), numentry%, inperr%(), item$(), itemlen%(), itemflag%())
  211.  
  212. 'there are some Wordstar type commands "scan% = 19 is Ctrl S". I hate Wordstar so I never completed all the commands.
  213.  
  214. LOCATE , , 0
  215. insertkey% = 0     'make typeover the default
  216. sc1% = 6           'cursor size for default typeover
  217. sc2% = 7
  218.         FOR menuitem% = 1 TO numentry%                  'make sure that existing entries have proper length
  219.                 IF LEN(item$(menuitem%)) < itemlen%(menuitem%) THEN
  220.                         item$(menuitem%) = item$(menuitem%) + STRING$((itemlen%(menuitem%) - LEN(item$(menuitem%))), " ") 'pad with spaces
  221.                 ELSEIF LEN(item$(menuitem%)) > itemlen%(menuitem%) THEN
  222.                         item$(menuitem%) = LEFT$(item$(menuitem%), itemlen%(menuitem%))  'truncate if necessary
  223.                 END IF
  224.         NEXT menuitem%
  225.         itemnum% = 1    'start a first input entry
  226.         FOR entry% = 1 TO numentry%                         'enter default data and/or spaces in proper places
  227.                 colm% = column%(entry%)
  228.                 FOR leng% = 1 TO itemlen%(entry%)
  229.                         COLOR rfg%, rbg%
  230.                         LOCATE row%(entry%), colm%
  231.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  232.                         PRINT defaultstr$;
  233.                         colm% = colm% + 1
  234.                 NEXT leng%
  235.         NEXT entry%
  236.         printcolumn% = column%(itemnum%)     'start at leftmost column
  237. ed1:    COLOR rfg%, rbg%: LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%                   'Place the cursor
  238.  
  239. ed2:    keypress$ = "": keypress$ = INKEY$: IF keypress$ = "" THEN GOTO ed2     'wait for keypress
  240.         scan% = ASC(keypress$)     'change keypress to integer
  241. ed4:
  242.         IF scan% = 27 THEN                'Esc
  243.                 IF inperr%(itemnum%) = 1 THEN  ' to prevent user from escaping from sub
  244.                         BEEP
  245.                 ELSE
  246.                         EXIT SUB
  247.                 END IF
  248.         END IF
  249.  
  250.         IF scan% > 31 AND scan% < 127 THEN           'Alphanum chars only
  251.                 DO
  252.                         SELECT CASE itemflag%(itemnum%)       'determine which set of characters are acceptable
  253.                                 CASE 0          'any alpha numeric
  254.                                 CASE 1          ' 0 to 9 and space
  255.                                         SELECT CASE scan%
  256.                                                 CASE 32, 48 TO 57   ' nothing to do. Let if "fall through" the SELECT CASE
  257.                                                 CASE ELSE
  258.                                                         BEEP
  259.                                                         GOTO ed2
  260.                                         END SELECT
  261.                                 CASE 2         '0 to 9, -,., space
  262.                                         SELECT CASE scan%
  263.                                                 CASE 32, 45, 46, 48 TO 57
  264.                                                 CASE ELSE
  265.                                                         BEEP
  266.                                                         GOTO ed2
  267.                                         END SELECT
  268.                         END SELECT
  269.  
  270.                 IF insertkey% = 0 THEN                     'typeover
  271.                         MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1, 1) = keypress$
  272.                         PRINT keypress$;
  273.  
  274.                 ELSE
  275.                         item$(itemnum%) = LEFT$(LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + CHR$(scan%) + (MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 1)), itemlen%(itemnum%))           'insert
  276.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  277.                         item$(itemnum%) = LEFT$(item$(itemnum%), itemlen%(itemnum%))
  278.                         PRINT item$(itemnum%);
  279.                 END IF
  280.                 scan% = 77                                   'move right 1 space
  281.                 EXIT DO
  282.                 LOOP
  283.         END IF
  284.  
  285.         IF scan% = 8 AND printcolumn% > column%(itemnum%) THEN          'Back Space
  286.                 printcolumn% = printcolumn% - 1
  287.                 LOCATE row%(itemnum%), printcolumn%, 1, sc1%, sc2%
  288.                 scan% = 83
  289.         END IF
  290.  
  291.         IF scan% = 0 THEN scan% = ASC(RIGHT$(keypress$, 1))             'Extended character
  292.  
  293.                                 ' scan% = 4 is the Wordstar Ctrl D
  294.         IF (scan% = 77 OR scan% = 4) AND printcolumn% < column%(itemnum%) - 1 + itemlen%(itemnum%) THEN     'Right arrow
  295.                 printcolumn% = printcolumn% + 1
  296.                 GOTO ed1
  297.         END IF
  298.                                  '19 = Ctrl S
  299.         IF (scan% = 75 OR scan% = 19) AND printcolumn% > column%(itemnum%) THEN          'Left arrow
  300.                 printcolumn% = printcolumn% - 1
  301.                 GOTO ed1
  302.         END IF
  303.  
  304.         IF scan% = 79 THEN                                  'end for    End of text
  305.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  306.                         printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  307.                 ELSE
  308.                         printcolumn% = column%(itemnum%) + LEN(RTRIM$(item$(itemnum%)))
  309.                         IF printcolumn% > column%(itemnum%) + itemlen%(itemnum%) - 1 THEN printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  310.                 END IF
  311.         GOTO ed1
  312.         END IF
  313.  
  314.         IF scan% = 99 THEN            'centre text on line
  315.  
  316.                 lenitm% = LEN(LTRIM$(RTRIM$(item$(itemnum%))))
  317.  
  318.                 item$(itemnum%) = SPACE$((itemlen%(itemnum%) - lenitm%) \ 2) + LTRIM$(RTRIM$(item$(itemnum%)))
  319.                 item$(itemnum%) = item$(itemnum%) + SPACE$(itemlen%(itemnum%) - LEN(item$(itemnum%)))
  320.                         LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  321.                         PRINT item$(itemnum%);
  322.  
  323.                 scan% = 80
  324.         END IF
  325.  
  326.  
  327.         IF scan% = 117 THEN                                   'ctrl +  end to go to end of line
  328.                 printcolumn% = column%(itemnum%) + itemlen%(itemnum%) - 1
  329.                 GOTO ed1
  330.         END IF
  331.  
  332.         IF scan% = 71 THEN                                  ' Home to beginning of text
  333.                 IF LEN(RTRIM$(item$(itemnum%))) = 0 THEN
  334.                         printcolumn% = column%(itemnum%)
  335.                 ELSE
  336.                         printcolumn% = column%(itemnum%) + ((itemlen%(itemnum%)) - (LEN(LTRIM$(item$(itemnum%)))))
  337.                         IF printcolumn% < column%(itemnum%) THEN printcolumn% = column%(itemnum%)
  338.                 END IF
  339.                 GOTO ed1
  340.         END IF
  341.  
  342.         IF scan% = 119 THEN                             'ctrl + home to start of line
  343.                 printcolumn% = column%(itemnum%)
  344.                 GOTO ed1
  345.         END IF
  346.  
  347.         IF (scan% = 80 OR scan% = 24) OR (scan% = 13 AND itemnum% <> numentry%) THEN  'Down Arrow  or Enter for next field
  348.  
  349.                 itemnum% = itemnum% + 1
  350.                         IF itemnum% > numentry% THEN itemnum% = numentry%
  351.                                 printcolumn% = column%(itemnum%)
  352.                                 GOTO ed1
  353.                         END IF
  354.       
  355.  
  356.         IF scan% = 81 THEN                             ' pgdn to last line
  357.                 itemnum% = numentry%
  358.                 printcolumn% = column%(itemnum%)
  359.                 GOTO ed1
  360.         END IF
  361.  
  362.         IF scan% = 72 OR scan% = 5 THEN                      'Up Arrow
  363.                 itemnum% = itemnum% - 1
  364.                 IF itemnum% < 1 THEN itemnum% = 1
  365.                 printcolumn% = column%(itemnum%)
  366.                 GOTO ed1
  367.         END IF
  368.  
  369.         IF scan% = 73 THEN                                 'pgup to top line
  370.                 itemnum% = 1
  371.                 printcolumn% = column%(itemnum%)
  372.                 GOTO ed1
  373.         END IF
  374.  
  375.         IF scan% = 83 THEN                                  'Delete
  376.                 item$(itemnum%) = LEFT$(item$(itemnum%), printcolumn% - column%(itemnum%)) + MID$(item$(itemnum%), printcolumn% - column%(itemnum%) + 2, itemlen%(itemnum%) - printcolumn% + column%(itemnum%) - 1) + " "
  377.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  378.                 PRINT item$(itemnum%);
  379.                 GOTO ed1
  380.         END IF
  381.  
  382.  
  383.         IF scan% = 96 THEN                                  ' control f3 to delete line
  384.                 item$(itemnum%) = SPACE$(itemlen%(itemnum%))
  385.                 printcolumn% = column%(itemnum%)
  386.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  387.                 PRINT item$(itemnum%);
  388.                 GOTO ed1
  389.         END IF
  390.  
  391.         IF scan% = 97 THEN                           'Ctrl F4 to copy
  392.                 cutline$ = item$(itemnum%)
  393.                 GOTO ed1
  394.         END IF
  395.  
  396.         IF scan% = 98 THEN                                   'Ctrl F5 to paste
  397.                 item$(itemnum%) = cutline$
  398.                 LOCATE row%(itemnum%), column%(itemnum%), 1, sc1%, sc2%
  399.                 PRINT LEFT$(item$(itemnum%), itemlen%(itemnum%));
  400.                 GOTO ed1
  401.         END IF
  402.  
  403.         IF scan% = 82 THEN                                     'insert toggle
  404.                 IF insertkey% = 0 THEN
  405.                         insertkey% = 1
  406.                         sc1% = 4       'change to 1/2 block cursor
  407.                         sc2% = 7
  408.                 ELSE
  409.                         insertkey% = 0
  410.                         sc1% = 6
  411.                         sc2% = 7
  412.                 END IF
  413.                 GOTO ed1
  414.          END IF
  415.  
  416.          IF scan% = 103 THEN         'ctrl f10 to exit
  417.                 scan% = 13
  418.          END IF
  419.       
  420. ed3:
  421.         IF scan% <> 13 THEN GOTO ed1
  422.  
  423.         FOR entry% = 1 TO numentry%                   'get rid of any ascii 0's
  424.         tempstring$ = ""
  425.                 FOR leng% = 1 TO LEN(item$(entry%))
  426.                         defaultstr$ = MID$(item$(entry%), leng%, 1)
  427.                         IF ASC(defaultstr$) = 0 THEN defaultstr$ = " "
  428.                         tempstring$ = tempstring$ + defaultstr$
  429.                 NEXT leng%
  430.         item$(entry%) = RTRIM$(tempstring$)
  431.         NEXT entry%
  432. LOCATE , , 0       'turn off cursor
  433. COLOR sfg%, sbg%
  434.  
  435. END SUB
  436.  
  437. FUNCTION Justify$ (text$, just%, winleft%, winright%)
  438. REM   function to justify text on a line within a window
  439. REM   text$ is the string to be modified
  440. REM   just% = one of the following
  441. REM   0 = not justiied
  442. REM   1 = left justified
  443. REM   2 = centre justified
  444. REM   3 = right justified
  445. REM   winleft% = the leftmost column of the window
  446. REM   winright% = the rightmost column of the window
  447.  
  448. SELECT CASE just%
  449.     CASE 0
  450.         'nothing needs to be done
  451.     CASE 1
  452.         text$ = LTRIM$(text$)    'delete leading spaces
  453.     CASE 2
  454.         centretext$ = LTRIM$(RTRIM$(text$))
  455.         IF LEN(centretext$) MOD 2 <> 0 THEN centretext$ = centretext$ + " "
  456.         lenitm% = LEN(centretext$) 'strip leading & trailing spaces and find length of remaining text
  457.         text$ = SPACE$(((winright% - winleft%) - lenitm%) \ 2) + centretext$  'add proper number of spaces to centre the text
  458.     CASE 3
  459.         lenitm% = LEN(LTRIM$(RTRIM$(text$))) 'find length of text with leading & trailing spaces deleted
  460.         text$ = SPACE$((winright% - winleft%) - (lenitm% + 1)) + LTRIM$(RTRIM$(text$)) 'add proper number of spaces before the text so that text is right justified
  461. END SELECT
  462.  
  463. Justify$ = text$  'change justify$ to modified string
  464.  
  465. END FUNCTION
  466.  
  467. SUB WindowSub (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  468. REM     wintop% & winbot% are the top & bottom rows of the window
  469. REM     winleft% & winright% are the left & right coloumns of the window
  470. REM     fbg% 'window background colour
  471. REM     winforecolour% 'window foreground colour
  472. REM     wintext$() is an array containing the text of each line in the window
  473. REM     winborder% is a flag which signals the program to add a border(frame) around the window
  474. REM         0 = no border, 1 = border
  475.  
  476. fbg% = winbackcolour% 'window background colour
  477. ffg% = winforecolour% 'window foreground colour
  478.  
  479.        PCOPY 0, 1  ' copy the current screen to the second page, which is 1
  480.  
  481.         textline% = 1
  482.             FOR winline% = wintop% TO winbot%         'put in window filled with
  483.                 LOCATE winline%, winleft% + 1         'spaces of background colour
  484.                 COLOR winforecolour%, winbackcolour%
  485.                 PRINT SPACE$(winright% - winleft%);
  486.                 LOCATE winline%, winleft% + 1
  487.                 PRINT wintext$(textline%);            'print text in window
  488.                 textline% = textline% + 1
  489.             NEXT winline%
  490.  
  491.         IF winborder% = 1 THEN CALL Frame(wintop%, winbot%, winleft%, winright%)  'add fram if desired
  492.  
  493.         pause$ = INPUT$(1)    'pause ofter window is complete
  494.  
  495.         PCOPY 1, 0  'copy original screen back to active screen
  496.  
  497. ERASE wintext$         'get the array out of memory
  498.  
  499. END SUB
  500.  
  501. SUB WindowSub2 (wintop%, winbot%, winleft%, winright%, winforecolour%, winbackcolour%, wintext$(), winborder%)
  502. REM     wintop% & winbot% are the top & bottom rows of the window
  503. REM     winleft% & winright% are the left & right coloumns of the window
  504. REM     fbg% 'window background colour
  505. REM     winforecolour% 'window foreground colour
  506. REM     wintext$() is an array containing the text of each line in the window
  507. REM     winborder% is a flag which signals the program to add a border(frame) around the window
  508. REM         0 = no border, 1 = border
  509.  
  510. fbg% = winbackcolour% 'window background colour
  511. ffg% = winforecolour% 'window foreground colour
  512.  
  513.         'set up 2 dimensional array to store characters "under" the window
  514.         DIM charascii%(wintop% TO winbot%, winleft% TO winright%)
  515.  
  516.         'same as above but to store color attributes
  517.         DIM charattrib%(wintop% TO winbot%, winleft% TO winright%)
  518.  
  519.         FOR winline% = wintop% TO winbot%
  520.             FOR wincolumn% = winleft% TO winright%
  521.                 charascii%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%)     'fill character array
  522.                 charattrib%(winline%, wincolumn%) = SCREEN(winline%, wincolumn%, 1)  'fill attribute array
  523.             NEXT wincolumn%
  524.         NEXT winline%
  525.  
  526.             textline% = 1
  527.             FOR winline% = wintop% TO winbot%         'put in window filled with
  528.                 LOCATE winline%, winleft% + 1         'spaces of background colour
  529.                 COLOR winforecolour%, winbackcolour%
  530.                 PRINT SPACE$(winright% - winleft%);
  531.                 LOCATE winline%, winleft% + 1
  532.                 PRINT wintext$(textline%);            'print text in window
  533.                 textline% = textline% + 1
  534.             NEXT winline%
  535.  
  536.         IF winborder% = 1 THEN CALL Frame(wintop%, winbot%, winleft%, winright%)  'add fram if desired
  537.  
  538.         pause$ = INPUT$(1)    'pause ofter window is complete
  539.         
  540.         FOR winline% = wintop% TO winbot%               'delete window and replace
  541.            FOR wincolumn% = winleft% TO winright%       'original screen
  542.                 LOCATE winline%, wincolumn%
  543.                 COLOR charattrib%(winline%, wincolumn%) MOD 16, (charattrib%(winline%, wincolumn%) AND &H70) \ 16  'parse stored colour attributes to foreground and background
  544.                 PRINT CHR$(charascii%(winline%, wincolumn%))   'print stored characters
  545.             NEXT wincolumn%
  546.         NEXT winline%
  547.  
  548. ERASE wintext$         'get the arrays out of memory
  549. ERASE charascii%
  550. ERASE charattrib%
  551.  
  552. END SUB
  553.  
  554.